home *** CD-ROM | disk | FTP | other *** search
/ MacWorld UK 2000 March / MW_UK_2000_03.iso / Shareware World / Utilities / Text Processing / Alpha / Tcl / SystemCode / alphaHooks.tcl < prev    next >
Encoding:
Text File  |  1999-11-02  |  26.8 KB  |  868 lines  |  [TEXT/ALFA]
  1. ## -*-Tcl-*-
  2.  # ###################################################################
  3.  #  Vince's Additions - an extension package for Alpha
  4.  # 
  5.  #  FILE: "alphaHooks.tcl"
  6.  #                                    created: 18/7/97 {5:10:18 pm} 
  7.  #                                last update: 11/02/1999 {19:02:24 PM} 
  8.  #  Author: Vince Darley
  9.  #  E-mail: <vince@santafe.edu>
  10.  #    mail: 317 Paseo de Peralta, Santa Fe, NM 87501
  11.  #     www: <http://www.santafe.edu/~vince/>
  12.  #  
  13.  # Copyright (c) 1997-1999  Vince Darley, all rights reserved
  14.  #  
  15.  # Description: 
  16.  #  
  17.  #  Here are the current hooks:
  18.  #  
  19.  #  activateHook changeMode closeHook deactivateHook modifyModeFlags 
  20.  #  quitHook resumeHook saveasHook saveHook savePostHook suspendHook
  21.  #  openHook
  22.  #  
  23.  #  There's also a 'mode::init' hook which will be called the first
  24.  #  time a mode is started up.  Note that the mode exists, but its
  25.  #  variables have not yet been made global, and its menus have not
  26.  #  yet been inserted into the menu bar.
  27.  #  
  28.  #  There's also a 'startupHook' which is called when Alpha starts
  29.  #  up, but after all other initialisation has taken place (before
  30.  #  any files are opened though).
  31.  #  
  32.  #  There's also a 'launch' hook for when an app is launched.
  33.  #  
  34.  #  Use of such lists as 'savePostHooks' is obsolete.
  35.  #  These lists are ignored, use hook::register instead.
  36.  #  
  37.  #  History
  38.  # 
  39.  #  modified by  rev reason
  40.  #  -------- --- --- -----------
  41.  #  18/7/97  VMD 1.0 original
  42.  #  22/7/97  VMD 1.1 fixed all bugs ;-) and added the above examples.
  43.  # ###################################################################
  44.  ##
  45.  
  46. namespace eval mode {}
  47. namespace eval win {}
  48.  
  49. lappend mode::procs carriageReturn OptionTitleBar OptionTitleBarSelect \
  50.   electricLeft electricRight electricSemi indentLine indentRegion \
  51.   parseFuncs MarkFile
  52.  
  53. proc saveHook name {
  54.     global backup backupExtension backupFolder mode win::Modes \
  55.       backupAgeRequirementInHours modifiedVars
  56.     hook::callAll saveHook [set win::Modes($name)] $name
  57.     if {![file exists $name]} {
  58.     regsub { <[0-9]+>$} $name {} name
  59.     }
  60.     if {$backup} {
  61.     if {$backupFolder != "" && ![file exists $backupFolder]} {
  62.         if {![dialog::yesno "Create backup folder '$backupFolder'?"]} {
  63.         alertnote "Backup saved in document's folder."
  64.         set backupFolder ""
  65.         lappend modifiedVars backupFolder
  66.         } elseif {[catch {file::ensureDirExists $backupFolder}]} {
  67.         alertnote "Couldn't create backup folder. Backup saved in document's folder."
  68.         set backupFolder ""
  69.         lappend modifiedVars backupFolder
  70.         }
  71.     }
  72.     set dir $backupFolder
  73.  
  74.     if {![string length $dir]} {
  75.         set dir [file dirname $name]
  76.     }
  77.     if {$backupExtension == "" && $backupFolder == ""} {
  78.         set backupExtension ~
  79.         lappend modifiedVars backupExtension
  80.     }
  81.     set backfile [file join $dir [file tail $name]$backupExtension]
  82.     if {$backupExtension == "" && [file dirname $name] == $backupFolder} {
  83.         append backfile ~
  84.     }
  85.     if {[file exists $backfile]} {
  86.         getFileInfo $name a
  87.         if {[expr {([now] - $a(modified) + 0.0)/3600}] < $backupAgeRequirementInHours} {
  88.         return
  89.         }
  90.         catch {file delete $backfile}
  91.     }
  92.     message "Backing up $backfile"
  93.     catch {file copy $name $backfile}
  94.     }
  95.  
  96. }
  97.  
  98. proc saveUnmodified {} {
  99.     set name [win::Current]
  100.     if {[file exists $name] || \
  101.       ([regsub { <\w+>$} $name {} name] && [file exists $name])} {
  102.     getFileInfo $name arr
  103.     set mod $arr(modified)
  104.     save
  105.     setFileInfo $name modified $mod
  106.     return
  107.     }
  108.     # shouldn't really get here!
  109.     error "File doesn't exist"
  110. }
  111.  
  112. ## 
  113.  # -------------------------------------------------------------------------
  114.  # 
  115.  # "changeMode" --
  116.  # 
  117.  #  A very important procedure.  It handles all switching from one mode
  118.  #  to another.  This means it has to adjust menus, floating windows,
  119.  #  global variables, mode prefs, and call a number of hooks.
  120.  #  
  121.  #  It maintains a list of variables which the new mode over-rides from
  122.  #  the global scope, and recreates them.  This allows a mode to have
  123.  #  its own value for a global variable without messing anything up.
  124.  # -------------------------------------------------------------------------
  125.  ##
  126. proc changeMode {newMode} {
  127.     global lastMode dummyProc mode seenMode PREFS global::_varMem \
  128.       mode::features global::features global::_oldTabSize \
  129.       alpha::changingMode
  130.     
  131.     # This section should restore any internally shadowed globals, 
  132.     # currently only tabSize may be stored by 'new'
  133.     if {[info exists global::_oldTabSize]} {
  134.     global tabSize
  135.     set tabSize [set global::_oldTabSize]
  136.     unset global::_oldTabSize
  137.     }
  138.     
  139.     set lastMode $mode
  140.     set mode $newMode
  141.     if {$lastMode == $mode} {
  142.         if {$newMode != ""} {
  143.         displayMode $newMode
  144.     }
  145.         return
  146.     }
  147.     if {$lastMode == ""} {
  148.     renameMenuItem -m Config "Mode Prefs" "${mode} Mode Prefs"
  149.     catch {menuEnableHook 1}
  150.     } elseif {$mode == ""} {
  151.     renameMenuItem -m Config "${lastMode} Mode Prefs" "Mode Prefs"
  152.     catch {menuEnableHook 0}
  153.     } else {
  154.     renameMenuItem -m Config "${lastMode} Mode Prefs" "${mode} Mode Prefs"
  155.     }
  156.     # Some code would like to know whether we're in the process
  157.     # of changing mode or not (e.g. complex package activation/deactivation
  158.     # sequences).
  159.     set alpha::changingMode 1
  160.     
  161.     # Get rid of all the old mode's variables, but only if it is necessary
  162.     # (Else we screw up traces on those variables)
  163.     global ${lastMode}modeVars
  164.     if {[info exists ${lastMode}modeVars]} {
  165.         foreach v [array names ${lastMode}modeVars] {
  166.         if {![info exists global::_varMem($v)]} {
  167.         global $v
  168.         catch {unset $v}
  169.         }
  170.         }
  171.     }
  172.     floatShowHide off $lastMode
  173.     if {[info exists global::_varMem]} {
  174.     foreach v [array names global::_varMem] {
  175.         global $v
  176.         set $v [set global::_varMem($v)]
  177.     }
  178.     unset global::_varMem
  179.     }
  180.     if {[info exists mode::features($mode)]} {
  181.     set onoff [package::onOrOff [set mode::features($mode)] $lastMode]
  182.     } else {
  183.     set onoff [package::onOrOff "" $lastMode]
  184.     }
  185.     
  186.     eval package::deactivate [lindex $onoff 0]
  187.     
  188.     # These lines must load the mode vars into the mode var scope.
  189.     if {[info exists dummyProc($mode)]} { $dummyProc($mode) }
  190.     if {![info exists seenMode($mode)]} {
  191.     eval package::initialise [lindex $onoff 1]
  192.     hook::callAll mode::init $mode
  193.     }
  194.     # once the vars are in mode-var scope (= the <mode>modeVars array),
  195.     # they can be transfered to the global scope.  A future version of
  196.     # Alpha with Tcl8.0 namespaces may not need to do this.
  197.     global ${mode}modeVars
  198.     if {[info exists ${mode}modeVars]} {
  199.         foreach v [array names ${mode}modeVars] {
  200.             global $v
  201.         if {[info exists $v]} { 
  202.         set global::_varMem($v) [set $v]
  203.         }
  204.             set $v [set ${mode}modeVars($v)]
  205.         }
  206.     }
  207.     
  208.     eval package::activate [lindex $onoff 1]
  209.     floatShowHide on $mode
  210.  
  211.     if {![info exists seenMode($mode)]} {
  212.     global mode::procs
  213.     #foreach p ${mode::procs} {
  214.     #    if {[info commands ${mode}::${p}] == ""} {
  215.     #    auto_load ${mode}::${p}
  216.     #    }
  217.     #}
  218.     set seenMode($mode) 1
  219.     if {($mode != "") && [file exists [file join $PREFS ${mode}Prefs.tcl]]} {
  220.         if {[catch {uplevel \#0 [list source [file join $PREFS ${mode}Prefs.tcl]]}]} {
  221.                 alertnote "Your preferences file '${mode}Prefs.tcl has an error."
  222.             } 
  223.         }
  224.     }
  225.         
  226.     if {$newMode != ""} {
  227.     displayMode $newMode
  228.     }
  229.  
  230.     hook::callAll changeMode $mode $mode
  231.  
  232.     # Reset this.
  233.     set alpha::changingMode 0
  234. }
  235.  
  236. ## 
  237.  # -------------------------------------------------------------------------
  238.  # 
  239.  # "requireOpenWindowsHook" --
  240.  # 
  241.  #  En-/disable meaningless menu items which would require the presence
  242.  #  of a certain number of windows to be active
  243.  #  
  244.  #  This proc should only be called from 'openHook' and 'closeHook'.
  245.  #  
  246.  #  You can register with it using 
  247.  #  
  248.  #  'hook::register requireOpenWindowsHook [list menu item] N'
  249.  #  
  250.  #  where 'N' is the number of windows required (1 or 2 usually)
  251.  #  (and deregister etc using hook::deregister).
  252.  #  
  253.  #  We only really need the catch in here for two reasons:
  254.  #  (i) in case bad menus are registered accidentally
  255.  #  (ii) so startup errors can open a window without hitting another error
  256.  #  in the middle of doing that!
  257.  # -------------------------------------------------------------------------
  258.  ##
  259. proc requireOpenWindowsHook {requiredNum} {
  260.     global win::Active
  261.     foreach count $requiredNum {
  262.     set enable [expr {[llength [set win::Active]] >= $requiredNum ? 1 : 0}]
  263.     foreach i [hook::information requireOpenWindowsHook $requiredNum] {
  264.         catch "enableMenuItem $i $enable"
  265.     }
  266.     }
  267. }
  268.  
  269. ## 
  270.  # -------------------------------------------------------------------------
  271.  # 
  272.  # "menuEnableHook" --
  273.  # 
  274.  #  This hook is called to turn menu items on or off.  It is called 
  275.  #  whenever there are no windows, or when we go from 0->1 window.
  276.  #  
  277.  #  It should deal with all standard menus.  It does not deal with
  278.  #  special menu items like 'save', 'revert',.. which require more
  279.  #  information.
  280.  #  
  281.  #  It is called from changeMode.
  282.  #  
  283.  #  Andreas wrote most of this proc.
  284.  #  
  285.  #  Due to a deficiency in MacOS/MercutioMDEF/Alpha (not sure who
  286.  #  the culprit is!), key-bindings attached to menu items are still
  287.  #  triggered even if the menu item is inactive.
  288.  # -------------------------------------------------------------------------
  289.  ##
  290. proc menuEnableHook {{haveWin 1}} {
  291.     global winMenu mode
  292.     # we only get here if there are no windows, or 1 window which we
  293.     # just opened.  Otherwise nothing will be different to last time.
  294.     enableMenuItem File close $haveWin
  295.     enableMenuItem File closeAll $haveWin
  296.     enableMenuItem File closeFloat $haveWin
  297.     enableMenuItem File saveAs… $haveWin
  298.     enableMenuItem File saveACopyAs… $haveWin
  299.     if {[package::active printerChoicesMenu]} {
  300.     enableMenuItem File print $haveWin
  301.     } else {
  302.     enableMenuItem File print… $haveWin
  303.     }
  304.     enableMenuItem File printAll $haveWin
  305.     eval [lindex [list un {}] $haveWin]Bind 'p' <c> print
  306.     
  307.     enableMenuItem Edit undo $haveWin
  308.     enableMenuItem Edit redo $haveWin
  309.     enableMenuItem Edit cut $haveWin
  310.     enableMenuItem Edit copy $haveWin
  311.     enableMenuItem Edit paste $haveWin
  312.     enableMenuItem Edit selectAll $haveWin
  313.     enableMenuItem Edit selectParagraph $haveWin
  314.     enableMenuItem Edit clear $haveWin
  315.     enableMenuItem Edit twiddle $haveWin
  316.     enableMenuItem Edit twiddleWords $haveWin
  317.     enableMenuItem Edit shiftLeft  $haveWin
  318.     enableMenuItem Edit shiftLeftSpace  $haveWin
  319.     enableMenuItem Edit shiftRight  $haveWin
  320.     enableMenuItem Edit shiftRightSpace  $haveWin
  321.     enableMenuItem Edit balance  $haveWin
  322.  
  323.     if {[info tclversion] < 8.0} {
  324.         enableMenuItem Text fillParagraph $haveWin
  325.         enableMenuItem Text wrapParagraph $haveWin
  326.         enableMenuItem Text sentenceParagraph $haveWin
  327.         enableMenuItem Text fillRegion $haveWin
  328.         enableMenuItem Text wrapRegion $haveWin
  329.         enableMenuItem Text sentenceRegion $haveWin
  330.         enableMenuItem Text paragraphToLine $haveWin
  331.         enableMenuItem Text lineToParagraph $haveWin
  332.         enableMenuItem Text reverseSort $haveWin
  333.         enableMenuItem Text sortLines $haveWin
  334.         enableMenuItem Text sortParagraphs $haveWin
  335.         enableMenuItem Text zapInvisibles $haveWin
  336.         enableMenuItem Text tabsToSpaces $haveWin
  337.         enableMenuItem Text spacesToTabs $haveWin
  338.         enableMenuItem Text indentLine $haveWin
  339.         enableMenuItem Text indentSelection $haveWin
  340.         enableMenuItem Text upcaseRegion $haveWin
  341.         enableMenuItem Text downcaseRegion $haveWin
  342.         enableMenuItem Text strings $haveWin
  343.         enableMenuItem Text commentLine $haveWin
  344.         enableMenuItem Text uncommentLine $haveWin
  345.         enableMenuItem Text commentBox $haveWin
  346.         enableMenuItem Text uncommentBox $haveWin
  347.         enableMenuItem Text commentParagraph $haveWin
  348.         enableMenuItem Text uncommentParagraph $haveWin
  349.     enableMenuItem Config "Mode Prefs" $haveWin
  350.     } else {
  351.     enableMenuItem Text "" $haveWin
  352.     if {$mode == ""} {
  353.         enableMenuItem -m Config "Mode Prefs" $haveWin
  354.     } else {
  355.         enableMenuItem -m Config "${mode} Mode Prefs" $haveWin
  356.     }
  357.     }
  358.     
  359.     enableMenuItem Search searchStart $haveWin
  360.     enableMenuItem Search findAgain $haveWin
  361.     enableMenuItem Search findAgainBackward $haveWin
  362.     if { ![string compare [searchString] ""] && !$haveWin } {
  363.     enableMenuItem Search findInNextFile $haveWin
  364.     } else {
  365.     enableMenuItem Search findInNextFile 1
  366.     }
  367.     enableMenuItem Search enterSearchString $haveWin
  368.     enableMenuItem Search enterReplaceString $haveWin
  369.     enableMenuItem Search quickFind $haveWin
  370.     enableMenuItem Search quickFindRegexp $haveWin
  371.     enableMenuItem Search reverseQuickFind $haveWin
  372.     enableMenuItem Search replace $haveWin
  373.     enableMenuItem Search replace&FindAgain $haveWin
  374.     enableMenuItem Search replaceAll $haveWin
  375.     enableMenuItem Search placeBookmark $haveWin
  376.     enableMenuItem Search returnToBookmark $haveWin
  377.     enableMenuItem Search gotoLine $haveWin
  378.     enableMenuItem Search matchingLines $haveWin
  379.     enableMenuItem Search gotoMatch $haveWin
  380.     enableMenuItem Search nextMatch $haveWin
  381.     enableMenuItem Search gotoFunc $haveWin
  382.     enableMenuItem Search gotoFileMark $haveWin
  383.     enableMenuItem Search markHilite $haveWin
  384.     enableMenuItem Search namedMarks $haveWin
  385.     enableMenuItem Search unnamedMarks $haveWin
  386.     
  387.     enableMenuItem Utils AsciiEtc $haveWin
  388.     enableMenuItem Utils cmdDoubleClick $haveWin
  389.     enableMenuItem Utils winUtils $haveWin
  390.     enableMenuItem Utils spellcheckWindow $haveWin
  391.     enableMenuItem Utils spellcheckSelection $haveWin
  392.     enableMenuItem Utils wordCount $haveWin
  393.     
  394.     enableMenuItem Config setFontsTabs… $haveWin
  395.     
  396.     enableMenuItem $winMenu zoom $haveWin
  397.     enableMenuItem $winMenu defaultSize $haveWin
  398.     enableMenuItem $winMenu chooseAWindow $haveWin
  399.     enableMenuItem $winMenu iconify $haveWin
  400.     enableMenuItem $winMenu arrange $haveWin
  401.     enableMenuItem $winMenu splitWindow $haveWin
  402.     enableMenuItem $winMenu toggleScrollbar $haveWin
  403.     
  404.     if {!$haveWin} {
  405.     enableMenuItem File save 0
  406.     enableMenuItem File saveUnmodified 0
  407.     enableMenuItem File revert 0
  408.     enableMenuItem File revertToBackup 0
  409.     enableMenuItem File renameTo… 0
  410.     enableMenuItem File saveAll 0
  411.     }
  412.     
  413.     requireOpenWindowsHook 1
  414. }
  415.  
  416. proc savePostHook name {
  417.     # So modified date is ok
  418.     if {([file exists $name] && (![catch {getFileInfo $name info}])) || \
  419.       ([regsub { <[0-9]+>$} $name {} nm] && [file exists $nm] \
  420.       && (![catch {getFileInfo $nm info}]))} {
  421.     global win::Modified
  422.     set win::Modified($name) $info(modified)
  423.     } else {
  424.     if {[info tclversion] < 8.0} {
  425.         # Alpha bug workaround
  426.         set name [subst $name]
  427.         if {([file exists $name] && (![catch {getFileInfo $name info}])) || \
  428.           ([regsub { <[0-9]+>$} $name {} nm] && [file exists $nm] \
  429.           && (![catch {getFileInfo $nm info}]))} {
  430.         global win::Modified
  431.         set win::Modified($name) $info(modified)
  432.         } else {
  433.         alertnote "Weird, file '$name' doesn't seem to exist: please\
  434.           report the circumstances of this problem to the Alpha-D mailing list."
  435.         }
  436.     } else {
  437.         alertnote "Weird, file '$name' doesn't seem to exist: please\
  438.           report the circumstances of this problem to the Alpha-D mailing list."
  439.     }
  440.     }
  441.     hook::callAll savePostHook "" $name
  442. }
  443.  
  444. proc closeHook name {
  445.     global markStack win::Modes win::Active win::Current win::Dirty \
  446.       win::NumDirty win::Modified
  447.     hook::callAll closeHook [set win::Modes($name)] $name
  448.  
  449.     if {[info exists win::Dirty($name)]} {
  450.     incr win::NumDirty -1
  451.     unset win::Dirty($name)
  452.     enableMenuItem File saveAll [expr {${win::NumDirty} ? 1 : 0}]
  453.     }
  454.         
  455.     unset win::Modes($name)
  456.     if {[info exists win::Modified($name)]} {
  457.     unset win::Modified($name)
  458.     }
  459.     
  460.     if {[llength $markStack]} {
  461.         set markStack [lremove -glob $markStack $name*]
  462.     }
  463.     win::removeFromMenu $name
  464.  
  465.     if {[set ind [lsearch -exact ${win::Active} $name]] >= 0} {
  466.         set win::Active [lreplace ${win::Active} $ind $ind]
  467.     }
  468.     if {![llength [winNames]]} {
  469.     set win::Current ""
  470.     changeMode {}
  471.     }
  472.     requireOpenWindowsHook 2
  473. }
  474.  
  475. proc deactivateHook name {
  476.     hook::callAll deactivateHook "" $name
  477. }
  478.  
  479. proc suspendHook name {
  480.     hook::callAll suspendHook "" $name
  481.     global iconifyOnSwitch
  482.     global suspIconed
  483.     if {$iconifyOnSwitch} {
  484.         set wins [winNames -f]
  485.         set suspIconed ""
  486.         foreach win $wins {
  487.             if {![icon -f "$win" -q]} {
  488.                 lappend suspIconed $win
  489.                 icon -f "$win" -t
  490.             }
  491.         }
  492.         set suspIconed [lreverse $suspIconed]
  493.     }
  494. }
  495.  
  496. ## 
  497.  # -------------------------------------------------------------------------
  498.  # 
  499.  # "resumeHook" --
  500.  # 
  501.  #  The parameter 'name' is not used, so please ignore it.
  502.  # -------------------------------------------------------------------------
  503.  ##
  504. proc resumeHook name {
  505.     global iconifyOnSwitch resumeRevert suspIconed killCompilerErrors
  506.     
  507.     if {[info exists killCompilerErrors] && $killCompilerErrors} {
  508.     set wins [winNames -f]
  509.     if {[set res [lsearch $wins "*Compiler Errors*"]] >= 0} {
  510.         bringToFront [lindex $wins $res]
  511.         killWindow
  512.     }
  513.     }
  514.     
  515.     if {$iconifyOnSwitch && [info exists suspIconed]} {
  516.     set wins [winNames -f]
  517.     foreach win $suspIconed {
  518.         icon -f "$win" -o
  519.     }
  520.     unset suspIconed
  521.     }
  522.     if {$resumeRevert} {
  523.     set resumeRevert 0
  524.     revert
  525.     }
  526.     # Check if the foremost window needs to be have its modified
  527.     # status adjusted
  528.     modifiedCheck [win::Current]
  529.  
  530.     hook::callAll resumeHook "" $name
  531. }
  532.  
  533. proc modifiedCheck {name} {
  534.     if {$name != ""} {
  535.     if {([file exists $name] && (![catch {getFileInfo $name info}])) || \
  536.       ([regsub { <[0-9]+>$} $name {} nm] && [file exists $nm] \
  537.       && (![catch {getFileInfo $nm info}]))} {
  538.         if {[catch {getWinInfo -w $name arr}]} {
  539.         set mod 0
  540.         } else {
  541.         set dirty $arr(dirty)
  542.         if {!$dirty} {
  543.             global win::Modified
  544.             set mod [expr {[set win::Modified($name)] < $info(modified)}]
  545.             if {$mod} { 
  546.             diskModifiedHook $name
  547.             }
  548.         } else {
  549.             set mod 1
  550.         }
  551.         }
  552.         enableMenuItem File save $mod
  553.         enableMenuItem File revert $mod
  554.     }
  555.     }
  556. }
  557.  
  558. proc diskModifiedHook {name} {
  559.     message "File has changed on disk since last save."
  560.     hook::callAll diskModifiedHook
  561. }
  562.  
  563. ## 
  564.  # -------------------------------------------------------------------------
  565.  # 
  566.  # "saveasHook" --
  567.  # 
  568.  #  Called when saving a window which doesn't yet exist as a file
  569.  #  (in particular 'Untitled' windows) or when the user selects
  570.  #  saveAs.
  571.  # -------------------------------------------------------------------------
  572.  ##
  573. proc saveasHook {oldName newName} {
  574.     global win::Modes win::Active win::Current win::Modified
  575.     if {$oldName == $newName} return
  576.     win::removeFromMenu $oldName
  577.     win::addToMenu $newName
  578.     win::setMode $newName
  579.     changeMode [set win::Modes($newName)]
  580.     
  581.     if {[set ind [lsearch -exact ${win::Active} $oldName]] >= 0} {
  582.     set win::Active [linsert [lreplace ${win::Active} $ind $ind] 0 $newName]
  583.     } else {
  584.     # hmmm! this is bad.  The old window has gone!
  585.     set win::Active [linsert ${win::Active} 0 $newName]
  586.     }
  587.     
  588.     set win::Current $newName
  589.     if {[info exists win::Modes($oldName)]} {
  590.     unset win::Modes($oldName)
  591.     }
  592.     if {[info exists win::Modified($oldName)]} {
  593.     unset win::Modified($oldName)
  594.     }
  595.  
  596.     hook::callAll saveasHook [set win::Modes($newName)] $oldName $newName
  597.     refresh
  598. }
  599.  
  600. if {0 && [info tclversion] < 8.0} {
  601.     hook::register saveasHook callSavePostHook *
  602.     proc callSavePostHook {old new} {
  603.     savePostHook $new
  604.     }
  605. }
  606.  
  607. ## 
  608.  # -------------------------------------------------------------------------
  609.  # 
  610.  # "saveACopyAs" --
  611.  # 
  612.  # Finally a proc to add to your collection of Alpha bugs.
  613.  # copyFile has an interesting bug. If the destination file exists it
  614.  # puts the file in [pwd] instead. This proc makes sure it is removed first.
  615.  #  
  616.  # (This proc actually has nothing to do with hooks, but seemed to fit here)
  617.  # -------------------------------------------------------------------------
  618.  ##
  619. proc saveACopyAs {} {
  620.     if {[file exists [set nm [stripNameCount [win::Current]]]]} {
  621.     set nm2 [putfile "Save a copy as:" [file tail $nm]]
  622.     if {[file exists $nm2]} {file delete $nm2}
  623.     file copy $nm $nm2
  624.     }
  625. }
  626.  
  627.  
  628. ensureset win::Active ""
  629.  
  630. proc activateHook {name} {
  631.     global win::Modes win::Active win::Current win::Modified
  632.     
  633.     if {![info exists win::Modes($name)]} {
  634.     win::setMode $name
  635.     }
  636.     if {[set ind [lsearch -exact ${win::Active} $name]] == -1} {
  637.     set win::Active [linsert ${win::Active} 0 $name]
  638.     } elseif {$ind >= 1} {
  639.     set win::Active [linsert [lreplace ${win::Active} $ind $ind] 0 $name]
  640.     }
  641.     set win::Current $name
  642.     
  643.     changeMode [set win::Modes($name)]
  644.     
  645.     hook::callAll activateHook [set win::Modes($name)] $name
  646.     # if the file exists (this seems to be the quickest way to check)
  647.     if {[file exists $name] || \
  648.       ([regsub { <[0-9]+>$} $name {} nm] && [file exists $nm])} {
  649.     # this fails if the window is just opening, but then we know it's clean
  650.     if {[catch {getWinInfo -w $name arr}]} {
  651.         set dirty 0
  652.         set mod 0
  653.     } else {
  654.         set dirty $arr(dirty)
  655.         if {!$dirty} {
  656.         if {[info exists win::Modified($name)]} {
  657.             if {[info exists nm]} {
  658.             getFileInfo $nm modarr
  659.             } else {
  660.             getFileInfo $name modarr
  661.             }
  662.             set mod [expr {[set win::Modified($name)] < $modarr(modified)}]
  663.             if {$mod} { 
  664.             diskModifiedHook $name
  665.             }
  666.         } else {
  667.             # This is only reached if the window is just opening,
  668.             # and if we fix getWinInfo not to 'catch' above.
  669.             set mod 0
  670.         }
  671.         } else {
  672.         set mod 1
  673.         }
  674.     }
  675.     enableMenuItem File save $mod
  676.     enableMenuItem File saveUnmodified $dirty
  677.     enableMenuItem File revert $mod
  678.     enableMenuItem File revertToBackup 1
  679.     enableMenuItem File renameTo… 1
  680.     enableMenuItem Edit undo $dirty
  681.     } else {
  682.     enableMenuItem File save 0
  683.     enableMenuItem File saveUnmodified 0
  684.     enableMenuItem File revert 0
  685.     enableMenuItem File revertToBackup 0
  686.     enableMenuItem File renameTo… 0
  687.     enableMenuItem Edit undo 0
  688.     }
  689.     
  690. }
  691.  
  692. proc quitHook {} {
  693.     global PREFS alpha::tracingChannel
  694.     if {[file exists [file join $PREFS ftpTmp]]} {
  695.         catch {rm [file join $PREFS ftpTmp *]}
  696.     }
  697.     catch {close ${alpha::tracingChannel}}
  698.     prefs::saveModified
  699.     hook::callAll quitHook
  700. }
  701.  
  702. ## 
  703.  # -------------------------------------------------------------------------
  704.  # 
  705.  # "dirtyHook" --
  706.  # 
  707.  #  This proc currently has to keep track in the array 'win::Dirty' of
  708.  #  the dirty status of windows.  Its only use is if we close a dirty
  709.  #  window and select 'discard', we would otherwise have a faulty
  710.  #  'win::NumDirty' count.  If there's a different solution we should
  711.  #  get rid of the win::Dirty array.
  712.  #  
  713.  #  Note: closeHook is called after the window is gone, and killWindow
  714.  #  isn't called if you click in the close-box, so they don't solve
  715.  #  the problem.
  716.  # -------------------------------------------------------------------------
  717.  ##
  718. proc dirtyHook {name dirty} {
  719.     global winMenu win::NumDirty win::Dirty
  720.     markMenuItem -m $winMenu [file tail $name] $dirty "◊"
  721.     if {$dirty == "on" || $dirty == 1} {
  722.     set win::Dirty($name) 1
  723.     incr win::NumDirty 1
  724.     } else {
  725.     if {[info exists win::Dirty($name)]} {
  726.         unset win::Dirty($name)
  727.     }
  728.     incr win::NumDirty -1
  729.     }
  730.     enableMenuItem File save $dirty
  731.     enableMenuItem File saveUnmodified $dirty
  732.     enableMenuItem File revert $dirty
  733.     enableMenuItem File saveAll [expr {${win::NumDirty} ? 1 : 0}]
  734.     # we may still revertToBackup even if the file is clean.
  735.     # however we can't just revert.
  736.     enableMenuItem Edit undo $dirty
  737. }
  738.  
  739. proc openHook name {
  740.     global win::Modes autoMark mode screenHeight screenWidth \
  741.       forceMainScreen win::Modified PREFS file::config
  742.  
  743.     changeMode [set win::Modes($name)]
  744.     win::addToMenu $name
  745.     message ""
  746.  
  747.     if {[info exists file::config($name)]} {
  748.     foreach opt [set file::config($name)] {
  749.         catch {eval setWinInfo $opt}
  750.     }
  751.     unset file::config($name)
  752.     }
  753.     if {([file exists $name] && (![catch {getFileInfo $name info}])) || \
  754.       ([regsub { <[0-9]+>$} $name {} nm] && [file exists $nm] \
  755.       && (![catch {getFileInfo $nm info}]))} {
  756.         if {[info exists info(creator)] && ($info(creator) == {ttxt})} {
  757.             setWinInfo dirty 0
  758.         }
  759.         if {[info exists info(type)] && ($info(type) == {ttro})} {
  760.             catch {setWinInfo read-only 1}
  761.             message "Read-only!"
  762.         }
  763.     set win::Modified($name) $info(modified)
  764.     }
  765.     
  766.     global ${mode}modeVars
  767.     
  768.     if {$forceMainScreen} {
  769.         set geo [getGeometry]
  770.         set l [lindex $geo 0]; set t [lindex $geo 1]; set w [lindex $geo 2]; set h [lindex $geo 3]; 
  771.         if {($l < 0) || ($t < 35) || ([expr {$l + $w}] > $screenWidth) || ([expr {$t + $h + 18}] > $screenHeight)} {
  772.         defaultSize
  773.         }
  774.     }
  775.     getWinInfo arr
  776.     if {!$arr(read-only)} {
  777.     if {[info exists ${mode}modeVars(autoMark)] \
  778.       && [set ${mode}modeVars(autoMark)] \
  779.       && ![llength [getNamedMarks -n]]} {
  780.         markFile
  781.     }
  782.     }
  783.     
  784.     if {[string match "${PREFS}*defs.tcl" $name]} {setWinInfo read-only 1}
  785.     
  786.     requireOpenWindowsHook 2
  787.     
  788.     hook::callAll openHook [set win::Modes($name)] $name
  789. }
  790.  
  791. ## 
  792.  # -------------------------------------------------------------------------
  793.  # 
  794.  # "fileMovedHook" --
  795.  # 
  796.  #  Called by Alpha when a window's file has been moved behind our back.
  797.  #  (Only for Alpha using Tcl 8.0)
  798.  # -------------------------------------------------------------------------
  799.  ##
  800. proc fileMovedHook {from to} {
  801.     global win::Active winNumToName winNameToNum win::Modes win::Modified
  802.     if {[info exists winNameToNum($from)]} {
  803.     set i $winNameToNum($from)
  804.     unset winNameToNum($from)
  805.     set winNumToName($i) $to
  806.     set winNameToNum($to) $i
  807.     } else {
  808.     alertnote "Can't find old window.  Bad error."
  809.     }
  810.     set win::Modes($to) [set win::Modes($from)]
  811.     set win::Modified($to) [set win::Modified($from)]
  812.     unset win::Modes($from)
  813.     unset win::Modified($from)
  814.     set idx [lsearch -exact ${win::Active} $from]
  815.     if {$idx >= 0} {
  816.     set win::Active [lreplace ${win::Active} $idx $idx $to]
  817.     } else {
  818.     alertnote "Can't find the old window! Bad error in fileMovedHook."
  819.     }
  820.     hook::callAll fileMovedHook $from $to
  821. }
  822.  
  823. proc changeTextHook {name} {
  824.     global win::Modes
  825.     hook::callAll changeTextHook [set win::Modes($name)] $name
  826. }
  827.  
  828. proc revertHook {name} {
  829.     global win::Modified
  830.     if {([file exists $name] && (![catch {getFileInfo $name info}])) || \
  831.       ([regsub { <[0-9]+>$} $name {} nm] && [file exists $nm] \
  832.       && (![catch {getFileInfo $nm info}]))} {
  833.     set win::Modified($name) $info(modified)
  834.     }
  835.     enableMenuItem File save 0
  836.     enableMenuItem File revert 0
  837. }
  838.  
  839. proc revertToBackup {} {
  840.     global backup backupExtension backupFolder win::Modes
  841.  
  842.     set fname [stripNameCount [win::Current]]
  843.     set dir $backupFolder
  844.     if {$dir == ""} {
  845.         set dir [file dirname $fname]
  846.     }
  847.     set bname [file join $dir "[file tail $fname]$backupExtension"]
  848.     if {![file exists $bname]} {
  849.         beep
  850.         message "Backup file '$bname' does not exist"
  851.         return
  852.     }
  853.  
  854.     if {[dialog::yesno "Revert to backup dated '[join [mtime [file mtime $bname]]]'?"]} {
  855.         killWindow
  856.  
  857.         edit $bname
  858.         saveAs -f $fname
  859.     }
  860. }
  861.  
  862.  
  863.  
  864.  
  865.  
  866.  
  867.  
  868.